home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 September (IDG) / Sep99.iso / Shareware World / Utilities / Text Processing / Alpha / Tcl / SystemCode / textFill.tcl < prev    next >
Encoding:
Text File  |  1999-05-05  |  17.6 KB  |  573 lines  |  [TEXT/ALFA]
  1. ####################################################################
  2. # 
  3. # Much by Vince Darley.
  4. # 
  5. #                                    created: 26/11/96 {7:08:34 pm} 
  6. #                                last update: 05/05/1999 {18:20:37 PM}
  7. #  Author: Vince Darley
  8. #  E-mail: <darley@fas.harvard.edu>
  9. #    mail: Division of Applied Sciences, Harvard University
  10. #          Oxford Street, Cambridge MA 02138, USA
  11. #     www: <http://www.fas.harvard.edu/~darley/>
  12. #  
  13. ####################################################################
  14.  
  15. ## 
  16.  # Here's a brief explanation of the smart fillParagraph routines
  17.  # 
  18.  # 'fillParagraph' 
  19.  # 
  20.  #  If there's a selection, then fill all paragraphs in that selection.  If
  21.  #  not then fill the paragraph surrounding the insertion point.  The
  22.  #  definition of a 'paragraph' may be mode dependent (see paraStart,
  23.  #  paraFinish)
  24.  #       
  25.  # 'fillOneParagraph'
  26.  # 
  27.  #  Fills the single paragraph surrounding the insertion point.  If called
  28.  #  with parameter '0', it doesn't bother to remember where the insertion
  29.  #  point was, which makes multiple paragraph fills quicker when called by
  30.  #  'fillParagraph'.  Works for mode-dependent definitions of paragraphs and
  31.  #  for commented out text (such as this paragraph here!).  
  32.  #       
  33.  # 'rememberWhereYouAre'
  34.  # 
  35.  #  Given the start of a paragraph and the point to remember, this returns a
  36.  #  record which must be passed to the following function so that it can
  37.  #  find the spot later, even after the paragraph has had
  38.  #  space/tabs/new-lines meddled with.  An optional last argument is a list
  39.  #  of other characters quoted so they are regexp insensitive, which should
  40.  #  also be ignored.  This is used so we can remember positions in text
  41.  #  which has cosmetic characters on the left/right which are not wrapped
  42.  #  (such as the hashes to the left here!).
  43.  #       
  44.  # 'goBackToWhereYouWere'
  45.  # 
  46.  #  Given the beginning and end of a selection, and a previous record, where
  47.  #  the beginning, and record correspond to a previous call of
  48.  #  'rememberWhereYouAre', this procedure will move the insertion point to
  49.  #  the correct place.
  50.  #       
  51.  # 'paraStart'
  52.  #    
  53.  #  Finds the start of the paragraph containing the insertion point.
  54.  #       
  55.  # 'paraFinish'
  56.  # 
  57.  #  Finds the end of the paragraph containing the insertion point.
  58.  ##
  59.     
  60. proc fillParagraph {} {
  61.     if {[pos::compare [getPos] == [selEnd]]} {
  62.     fillOneParagraph
  63.     } else {    
  64.     set start [getPos]
  65.     set end [selEnd]
  66.     set p $start
  67.     while {[pos::compare $p < $end] && [pos::compare $p < [maxPos]]} {
  68.         goto $p
  69.         set p [fillOneParagraph 0 $start $end]
  70.     }
  71.     goto $start
  72.     }
  73. }
  74.  
  75. proc rememberWhereYouAre {startPara pos endPara {commentReg ""}} {
  76.     set start [pos::math $pos -20]
  77.     if {[pos::compare $start < $startPara]} {
  78.     set start $startPara
  79.     }
  80.     set __g_remember_str [getText $start $pos]
  81.     if {[string length [string trim $__g_remember_str]] < 3} {
  82.     # there wasn't much to remember; try the other way
  83.     set end [pos::math $pos +20]
  84.     if {[pos::compare $end > $endPara]} {
  85.         set end $endPara
  86.     }
  87.     set __g_remember_str [getText $pos $end]
  88.     set __g_remember_dir 0
  89.     } else {
  90.     set __g_remember_dir 1
  91.     }
  92.     
  93.     set __g_remember_str [quote::Regfind $__g_remember_str]
  94.     regsub -all "\[ \t\r\n${commentReg}\]+" $__g_remember_str \
  95.       {[ \t\r\n${commentReg}]+} __g_remember_str
  96.     return [list $__g_remember_str $__g_remember_dir]
  97. }
  98.  
  99. proc goBackToWhereYouWere {start end memory} {
  100.     if {[lindex $memory 0] != "" } {
  101.     regexp -indices ".*([lindex $memory 0]).*" [getText $start $end] \
  102.       "" submatch
  103.     if {[info exists submatch]} {
  104.         set p [pos::math $start + [lindex $memory 1] + \
  105.           [lindex $submatch [lindex $memory 1]]]
  106.     } else {
  107.         set p $end
  108.     }
  109.     goto [expr {[pos::compare $p >= $end] ? [pos::math $end - 1] : $p}]
  110.     } else {
  111.     goto $start
  112.     }
  113. }
  114.  
  115. ## 
  116.  # -------------------------------------------------------------------------
  117.  #     
  118.  #    "getLeadingIndent" --
  119.  #    
  120.  #  Find the indentation of the line containing 'pos', and convert it to a
  121.  #  minimal form of tabs followed by spaces.  If 'size' is given, then the
  122.  #  variable of that name is set to the length of the indent.  Similarly
  123.  #  'halftab' can be set to half a tab. 
  124.  # -------------------------------------------------------------------------
  125.  ##
  126. proc getLeadingIndent { pos {size ""} {halftab ""} } {
  127.     # get the leading whitespace of the current line
  128.     set res [search -s -n -f 1 -r 1 "^\[ \t\]*" [lineStart $pos]]
  129.     
  130.     # convert it to minimal form: tabs then spaces, stored in 'front'
  131.     getWinInfo a
  132.     set sp [string range "              " 1 $a(tabsize) ]
  133.     regsub -all "($sp| +\t)" [eval getText $res] "\t" front
  134.     if { $size != "" } {
  135.     upvar $size ind
  136.     # get the length of the indent
  137.     regsub -all "\t" $front $sp lfront
  138.     set ind [string length $lfront]
  139.     }
  140.     if { $halftab != "" } {
  141.     upvar $halftab ht
  142.     # get the length of half a tab
  143.     set ht [string range "            " 1 [expr {$a(tabsize)/2}]]
  144.     }
  145.     
  146.     return $front
  147. }
  148.  
  149. ## 
  150.  # -------------------------------------------------------------------------
  151.  # 
  152.  # "fillOneParagraph" --
  153.  # 
  154.  #  Fixes: won't put a double-space after abbreviations like 'e.g.', 'i.e.'
  155.  #  
  156.  #  Works around the Alpha 'replaceText' bug.
  157.  # -------------------------------------------------------------------------
  158.  ##
  159. proc fillOneParagraph {{remember 1} {minstart ""} {maxend ""}} {
  160.     global leftFillColumn fillColumn doubleSpaces
  161.  
  162.     set pos [getPos]
  163.     if {[set inComment [text::isInComment $pos ch]]} {
  164.     # Find lines which contain just a comment char, but no actual text
  165.     # (We want to flow the text in the comment in its constituent
  166.     # paragraphs, not as one big block).
  167.     set ch [string trim $ch]
  168.     set chreg [quote::Regfind ${ch}]
  169.     if {$ch == "*"} {
  170.         # We assume it's a C-style comment
  171.         set start [pos::math [lindex [search -s -f 0 -r 1 "^\[ \t\]*(${chreg}+|/\\*+)\[ \t\]*\$" $pos] 1] +1]
  172.         set end [lindex [search -s -f 1 -r 1 "^\[ \t\]*(${chreg}+|\\*+/)\[ \t\]*\$" $pos] 0]
  173.     } else {
  174.         set start [lindex [search -s -n -f 0 -r 1 "^\[ \t\]*(${chreg}+\[ \t\]*${chreg}*\$|\[^${chreg} \t\]|\$)" $pos] 0]
  175.         set end [lindex [search -s -n -f 1 -r 1 "^\[ \t\]*(${chreg}+\[ \t\]*${chreg}*\$|\[^${chreg} \t\]|\$)" $pos] 0]
  176.         # The comment doesn't have a leading/trailing almost blank line
  177.         # Look for any line which is either blank, or starts with a 
  178.         # different character
  179.         if {$start == ""} {
  180.         set start [nextLineStart [lindex [search -s -f 0 -r 1 "^\[ \t\]*(\[^ \t[string index $ch 0]\]|\$)" $pos] 0]]
  181.         } else {
  182.         set start [nextLineStart $start]
  183.         }
  184.         if {$end == ""} {
  185.         set end [lindex [search -s -f 1 -r 1 "^\[ \t\]*(\[^ \t[string index $ch 0]\]|\$)" $pos] 0]
  186.         }
  187.     }
  188.     } else {
  189.     set start [paraStart $pos] 
  190.     if {[pos::compare $start > $pos]} {
  191.         set end [paraFinish $start]
  192.     } else {
  193.         set end [paraFinish $pos]
  194.     }
  195.     }
  196.     # Extra arguments allow us to specify a region in which to operate
  197.     if {$minstart != ""} {
  198.     if {[pos::compare $minstart > $start]} {
  199.         set start $minstart
  200.     }
  201.     }
  202.     if {$maxend != ""} {
  203.     if {[pos::compare $maxend < $end]} {
  204.         set end $maxend
  205.     }
  206.     }
  207.     
  208.     if {$remember} {
  209.     if {$inComment} {
  210.         set memory [rememberWhereYouAre $start $pos $end $chreg]
  211.     } else {
  212.         set memory [rememberWhereYouAre $start $pos $end]
  213.     }
  214.     }
  215.     
  216.     if {$inComment} {
  217.     set text [getText $start [nextLineStart $start]]
  218.     if {[set boxComment [regexp -- "(${chreg}+)\[\r\n\]" $text "" commentSuffix]]} {
  219.         set boxWidth [posX [pos::math [nextLineStart $start] -1]]
  220.     }
  221.     regsub -all -- $chreg $text [string range "   " 1 [string length $ch]] fr
  222.     regexp "^\[ \t\]*" $fr fr
  223.     set left [string length [text::maxSpaceForm $fr]]
  224.     if {$boxComment} {
  225.         set newFillColumn [expr {$boxWidth - $left - [string length $commentSuffix] -2}]
  226.     } else {
  227.         set newFillColumn [expr {$fillColumn - $left}]
  228.     }
  229.     
  230.     if {![regexp "^((\[ \t\]*${chreg}+)\[ \t\]*)" $text "" front commentPrefix]} {
  231.         alertnote "Sorry, I can't yet reflow the text inside this comment."
  232.         return $end
  233.     }
  234.     if {$boxComment} {
  235.         regsub -all "[quote::Regfind $commentSuffix](\r|\n|$)" [getText $start $end] "\\1" text
  236.         regsub -all "(^|\r|\n)[quote::Regfind $commentPrefix]" $text "" text
  237.     } else {
  238.         regsub -all "(^|\r|\n)[quote::Regfind $commentPrefix]" [getText $start $end] "" text
  239.     }
  240.     
  241.     regsub -all "\[ \t\r\n\]+" [string trim $text] " " text
  242.     } else {
  243.     # Get the leading whitespace of the current line and store length in 'left'
  244.     set front [getLeadingIndent $pos left]
  245.     # fill the text
  246.     regsub -all "\[ \t\r\n\]+" [string trim [getText $start $end]] " " text
  247.     set newFillColumn [expr {$fillColumn - $left}]
  248.     }
  249.     
  250.     # turn single spaces at end of sentences into double
  251.     if {$doubleSpaces} {regsub -all {(([^.][a-z]|[^a-zA-Z@]|\\@)[.?!]("|'|'')?([])])?) } $text {\1  } text}
  252.     #     if {$doubleSpaces} {regsub -all {(([^A-Z@]|\\@)[.?!][])'"]?) } $text {\1  } text}
  253.  
  254.     # temporarily adjust the fillColumns
  255.     set ol $leftFillColumn
  256.     set or $fillColumn
  257.     set leftFillColumn 0
  258.     set fillColumn $newFillColumn
  259.         
  260.     # break and indent the paragraph
  261.     regsub -all " ?\r" "\r[string trimright [breakIntoLines $text]]" "\r${front}" text
  262.     # reset columns
  263.     set leftFillColumn $ol
  264.     set fillColumn  $or
  265.     if {$inComment && $boxComment} {
  266.     global bind::_IndentSpaces
  267.     set newtext ""
  268.     foreach line [split $text "\r\n"] {
  269.         puts stdout [string length $line]
  270.         set pad [string range [set bind::_IndentSpaces] 0 [expr {$boxWidth- [string length $line] -2}]]
  271.         lappend newtext "$line$pad$commentSuffix"
  272.     }
  273.     set text "\r[join [lrange $newtext 1 end] \r]"
  274.     }
  275.     
  276.     # don't replace if nothing's changed
  277.     if {"$text\r" != "\r[getText $start $end]"} {
  278.     # workaround an alpha bug
  279.     if {$remember} { 
  280.         getWinInfo a
  281.         if {[pos::compare [rowColToPos $a(currline) 0] > $start]} { goto $start }
  282.     }
  283.     replaceText $start $end "[string range $text 1 end]\r"
  284.     if {$remember} {
  285.         goBackToWhereYouWere $start [pos::math $start + \
  286.           [string length $text]] $memory
  287.     }
  288.     }
  289.     
  290.     # in case we wish to fill a region
  291.     return $end
  292. }
  293.  
  294. ## 
  295.  # -------------------------------------------------------------------------
  296.  # 
  297.  #    "paraStart"    -- "paraFinish"
  298.  # 
  299.  #  Newly simplified version with fewer regexp '()' pairs.  Also I think it
  300.  #  deals better with TeX comments than the old regexp.
  301.  #     
  302.  #  "Start": It's pretty clear for non TeX modes how this works.  The only
  303.  #  key is that we start at the beginning of the current line and look
  304.  #  back.  We then have a quick check for whether we found that very
  305.  #  beginning (in which case return it) or if not (in which case we have
  306.  #  found the end of the previous paragraph) we move forward a line.
  307.  # 
  308.  #  "Finish": The only addition is the need for an additional check for
  309.  #  stuff which explicitly ends lines.
  310.  #       
  311.  # Results:
  312.  #  The start/finish position of the paragraph containing the given 'pos'
  313.  # 
  314.  # --Version--Author------------------Changes-------------------------------
  315.  #    1.1     <darley@fas.harvard.edu> Cut down on '()' pairs
  316.  #    1.2     Vince - March '96          Better filling for TeX tables ('hline')
  317.  #    1.3     Johan Linde - May '96   Now sensitive to HTML elements
  318.  #    1.4     <darley@fas.harvard.edu> Handle Tcl lists, top of file fix.
  319.  # -------------------------------------------------------------------------
  320.  ##
  321. proc paraStart {pos} {
  322.     global mode 
  323.     global ${mode}::startPara
  324.     if {[pos::compare $pos == [maxPos]]} {set pos [pos::math $pos - 1]}
  325.     set pos [lineStart $pos]
  326.     if {[info exists ${mode}::startPara]} {
  327.     set startPara [set ${mode}::startPara]
  328.     } else {
  329.     switch -- $mode {
  330.         "TeX" -
  331.         "Bib" {
  332.         global texParaCommands
  333.         set startPara {^[ \t]*$|\\\\[ \t]*$|(^|[^\\])%|\\h+line[ \t]*$|\$\$[ \t]*$|^[ \t]*(\\(}
  334.         append startPara $texParaCommands {)(\[.*\]|\{.*\}|•)*[ \t]*)+$}
  335.         } 
  336.         "HTML" {
  337.         global htmlParaCommands
  338.         set startPara {^[ \t]*$|</?(}
  339.         append startPara $htmlParaCommands {)([ \t\r]+[^>]*>|>)}
  340.         }
  341.         default {
  342.         set startPara {^([ \t]*|([\\%].*))$}
  343.         }
  344.     }
  345.     }
  346.  
  347.     set res [search -s -n -f 0 -r 1 -l [minPos] -- "$startPara" $pos]
  348.     if {![llength $res] || $res == "0 0" } {
  349.     # bug work-around.  Alpha fails to match '^' with start of file.
  350.     return [lineStart [lindex [search -s -f 1 -r 1 "\[^ \t\r\n\]" [minPos]] 0]]
  351.     } elseif {[pos::compare [lindex $res 0] == $pos]} {
  352.     return $pos
  353.     } else {
  354.     return [nextLineStart [lindex $res 0]]
  355.     }
  356.     
  357. }
  358.  
  359. proc paraFinish {pos} {
  360.     global mode
  361.     global ${mode}::endPara
  362.     set pos [lineStart $pos]
  363.     set end [maxPos]
  364.     if {[info exists ${mode}::endPara]} {
  365.     set endPara [set ${mode}::endPara]
  366.     } else {
  367.     switch -- $mode {
  368.         "TeX" -
  369.         "Bib" {
  370.         global texParaCommands
  371.         set endPara {^[ \t]*$|(^|[^\\])%|\$\$[ \t]*$|^[ \t]*(\\(}
  372.         append endPara $texParaCommands {)(\[.*\]|\{.*\}|•)*[ \t]*)+$}
  373.         } 
  374.         "HTML" {
  375.         global htmlParaCommands
  376.         set endPara {^[ \t]*$|</?(}
  377.         append endPara $htmlParaCommands {)([ \t\r\n]+[^>]*>|>)}
  378.         }
  379.         default {
  380.         set endPara {^([ \t]*|([\\%].*))$}
  381.         }
  382.     }
  383.     }
  384.     
  385.     set res [search -s -n -f 1 -r 1 -l $end -- "$endPara" $pos]
  386.     if {![string length $res]} {return $end}
  387.     set cpos [lineStart [lindex $res 0]]
  388.     if {[pos::compare $cpos == $pos]} {
  389.     return [nextLineStart $cpos]
  390.     }
  391.     # A line which ends in '\\', '%...', '\hline', '\hhline'
  392.     # signifies the end of the current paragraph in TeX mode
  393.     # (the above checked for beginning of the next paragraph).
  394.     if { $mode == "TeX" || $mode == "Bib" } {
  395.     set res2 [search -s -n -f 1 -r 1 -l $end {((\\\\|\\h+line)[ \t]*|[^\\]%.*)$} $pos]
  396.     if {[string length $res2]} {
  397.         if {[pos::compare [lindex $res2 0] < $cpos] } {
  398.         return [nextLineStart [lindex $res2 0]]
  399.         }
  400.     }
  401.     }
  402.  
  403.     return $cpos
  404.     
  405. }
  406.  
  407. proc selectParagraph {} {
  408.     set pos [getPos]
  409.     set start [paraStart $pos] 
  410.     set finish [paraFinish $pos]
  411.     goto $start
  412.     select $start $finish
  413. }
  414.  
  415. proc sentenceParagraph {} {
  416.     set pos [getPos]
  417.     set start [paraStart $pos] 
  418.     set finish [paraFinish $pos]
  419.     
  420.     set t [string trim [getText $start $finish]]
  421.     set period [regexp {\.$} $t]
  422.     regsub -all "\[ \t\r\n\]+" $t " " text
  423.     regsub -all {\. } $text "Δ" text
  424.     set result ""
  425.     foreach line [split [string trimright $text {.}] "Δ"] {
  426.     if {[string length $line]} {
  427.         append result [breakIntoLines $line] ".\r"
  428.     }
  429.     }
  430.     if {!$period && [regexp {\.\r} $result]} {
  431.     set result [string trimright $result ".\r"]
  432.     append result "\r"
  433.     }
  434.     if {$result != [getText $start $finish]} {
  435.     replaceText $start $finish $result
  436.     }
  437.     goto $pos
  438. }
  439.  
  440. proc getEndpts {} {
  441.     if {[pos::compare [getPos] == [selEnd]]} {
  442.     set start [getPos]
  443.     set finish [getMark]
  444.     if {[pos::compare $start > $finish]} {
  445.         set temp $start
  446.         set start $finish
  447.         set finish $temp
  448.     }
  449.     } else {
  450.     set start [getPos]
  451.     set finish [selEnd]
  452.     }
  453.     return [list $start $finish]
  454. }
  455.  
  456.  
  457. proc fillRegion {} {
  458.     global leftFillColumn
  459.     set ends [getEndpts]
  460.     set start [lineStart [lindex $ends 0]]
  461.     set finish [lindex $ends 1]
  462.     goto $start
  463.     set text [fillText $start $finish]
  464.     replaceText $start $finish [format "%$leftFillColumn\s" ""] $text "\r"
  465. }
  466.     
  467. proc wrapParagraph {} {
  468.     set pos [getPos]
  469.     set start [paraStart $pos] 
  470.     set finish [paraFinish $pos]
  471.     goto $start
  472.     wrapText $start $finish
  473.     goto $pos
  474. }
  475.  
  476. proc wrapRegion {} {
  477.     set ends [getEndpts]
  478.     set start [lineStart [lindex $ends 0]]
  479.     set finish [lindex $ends 1]
  480.     if {[pos::compare $start == $finish]} {
  481.     set finish [maxPos]
  482.     }
  483.     wrapText $start $finish
  484. }
  485.     
  486.  
  487.  
  488. # Remove text from window, transform, and insert back into window.
  489. proc fillText {from to} {
  490.     global doubleSpaces
  491.     set text [getText $from $to]
  492.     regexp "^\[ \t\]*" $text front
  493.     regsub -all "\[ \t\n\r\]+" [string trim $text] " " text
  494.     if {$doubleSpaces} {regsub -all {(([^.][a-z]|[^a-zA-Z@]|\\@)[.?!]("|'|'')?([])])?) } $text {\1  } text}
  495.     regsub -all " ?\[\r\n\]" [string trimright [breakIntoLines $text]] "\r${front}" text
  496.     return $front$text
  497. }
  498.  
  499. proc paragraphToLine {} {
  500.     global fillColumn
  501.     global leftFillColumn
  502.     set fc $fillColumn
  503.     set lc $leftFillColumn
  504.     set fillColumn 10000
  505.     set leftFillColumn 0
  506.     fillRegion
  507.     set fillColumn $fc
  508.     set leftFillColumn $lc
  509. }
  510.  
  511. proc lineToParagraph {} {
  512.     global fillColumn
  513.     global leftFillColumn
  514.     set fc $fillColumn
  515.     set fillColumn 75
  516.     set lc $leftFillColumn
  517.     set leftFillColumn 0
  518.     fillRegion
  519.     set fillColumn $fc
  520.     set leftFillColumn $lc
  521. }
  522.  
  523.  
  524. #set sentEnd {[.!?](\r|\n| +)}
  525. set sentEnd {(\r\r|\n\n|[.!?](\r|\n| +))}
  526. set sentBeg {[\r\n ][A-Z]}
  527.  
  528. proc nextSentence {} {
  529.     global sentBeg sentEnd
  530.     if {![catch {search -s -f 1 -r 1 $sentEnd [getPos]} mtch]} {
  531.     if {![catch {search -s -f 1 -r 1 -i 0 $sentBeg [pos::math [lindex $mtch 1] - 1]} mtch]} {
  532.         goto [pos::math [lindex $mtch 0] + 1]
  533.     }
  534.     }
  535. }
  536.  
  537.  
  538. proc prevSentence {} {
  539.     global sentBeg sentEnd
  540.     if {[catch {search -s -f 0 -r 1 $sentBeg [pos::math [getPos] - 2]} mtch]} return
  541.     if {![catch {search -s -f 0 -r 1 $sentEnd [lindex $mtch 1]} mtch]} {
  542.     if {![catch {search -s -f 1 -r 1 -i 0 $sentBeg [pos::math [lindex $mtch 1] - 1]} mtch]} {
  543.         goto [pos::math [lindex $mtch 0] + 1]
  544.     }
  545.     }
  546. }
  547.  
  548. #===============================================================================
  549. # Called by Alpha to do "soft wrapping"
  550. proc softProc {pos start next} {
  551.     global leftFillColumn
  552.     goto $start
  553.     set finish [paraFinish $start]
  554.     set text [fillText $start $finish]
  555.     if {"${text}\r" != [getText $start $finish]} {
  556.     replaceText $start $finish [format "%$leftFillColumn\s" ""] $text "\r"
  557.     return 1
  558.     } else {
  559.     return 0
  560.     }
  561. }
  562.  
  563. proc dividingLine {} {
  564.     global mode
  565.     global ${mode}modeVars
  566.     if {[info exists ${mode}modeVars(prefixString)]} {
  567.     set a [string trim [set ${mode}modeVars(prefixString)]]
  568.     } else {
  569.     set a "#"
  570.     }
  571.     insertText "${a}===============================================================================\r"
  572. }
  573.